unit uDZLogWritter;

interface

uses
  SysUtils, Classes, DateUtils, uDZSysUtils, uDZTrace;
  
type
  TDzMultiFileLogWritter = class(TDzInterfacedObject, IDzTrace)
  private
    fLogFileDir: string;
    fLastLogTime: TDateTime;
    fLogSeparate: TDateTimePart;
    fTrace: IDzTrace;
    fDateTimeFormat: string;
    fVerbosity: TDzTraceVerbosity;
    fOptions: TTraceOptions;
    fEncoding: TTextEncoding;
  protected
    function GetVerbosity: TDzTraceVerbosity;
    procedure SetVerbosity(const Value: TDzTraceVerbosity);
    function GetOptions: TTraceOptions;
    procedure SetOptions(const Value: TTraceOptions);
    function GetDateTimeFormat: string;
    procedure SetDateTimeFormat(const Value: string);
    procedure Write(Severity: TDzTraceSeverity; const Text: AnsiString); overload;
    procedure Write(Severity: TDzTraceSeverity; const Text: WideString); overload;
    procedure Writeln(Severity: TDzTraceSeverity; const Text: AnsiString); overload;
    procedure Writeln(Severity: TDzTraceSeverity; const Text: WideString); overload;
    procedure FormatWrite(Severity: TDzTraceSeverity; const fmt: AnsiString;
      const args: array of const); overload;
    procedure FormatWrite(Severity: TDzTraceSeverity; const fmt: WideString;
      const args: array of const); overload;
    function GetAttribute(const Name: TNameString): Variant; override;
    procedure SetAttribute(const Name: TNameString;
      const Value: Variant); override;
  protected
    procedure CreateFileTracer(Tick: TDateTime);
  public
    constructor Create(const dir: string);
    destructor Destroy; override;
    procedure Flush;
    property LogSeparate: TDateTimePart read fLogSeparate write fLogSeparate;
    property Severity: TDzTraceVerbosity read fVerbosity write fVerbosity;
    property Options: TTraceOptions read fOptions write fOptions;
    property DateTimeFormat: string read fDateTimeFormat write fDateTimeFormat;
    property Encoding: TTextEncoding read fEncoding write fEncoding;
  end;

  TDzFixedSizeFileLogWritter = class(TDzInterfacedObject, IDzTrace)
  private
    fLogFileDir: string;
    fFileWritter: TDzFileTrace;
    fMaxFileSize: Integer;
    fDateTimeFormat: string;
    fVerbosity: TDzTraceVerbosity;
    fOptions: TTraceOptions;
    fEncoding: TTextEncoding;
  protected
    function GetVerbosity: TDzTraceVerbosity;
    procedure SetVerbosity(const Value: TDzTraceVerbosity);
    function GetOptions: TTraceOptions;
    procedure SetOptions(const Value: TTraceOptions);
    function GetDateTimeFormat: string;
    procedure SetDateTimeFormat(const Value: string);
    procedure Write(Severity: TDzTraceSeverity; const Text: AnsiString); overload;
    procedure Write(Severity: TDzTraceSeverity; const Text: WideString); overload;
    procedure Writeln(Severity: TDzTraceSeverity; const Text: AnsiString); overload;
    procedure Writeln(Severity: TDzTraceSeverity; const Text: WideString); overload;
    procedure FormatWrite(Severity: TDzTraceSeverity; const fmt: AnsiString;
      const args: array of const); overload;
    procedure FormatWrite(Severity: TDzTraceSeverity; const fmt: WideString;
      const args: array of const); overload;
    function GetAttribute(const Name: TNameString): Variant; override;
    procedure SetAttribute(const Name: TNameString;
      const Value: Variant); override;
  protected
    procedure CreateFileTracer(Tick: TDateTime);
  public
    constructor Create(const dir: string);
    destructor Destroy; override;
    procedure Flush;
    property MaxFileSize: Integer read fMaxFileSize write fMaxFileSize;
    property Severity: TDzTraceVerbosity read fVerbosity write fVerbosity;
    property Options: TTraceOptions read fOptions write fOptions;
    property DateTimeFormat: string read fDateTimeFormat write fDateTimeFormat;
    property Encoding: TTextEncoding read fEncoding write fEncoding;
  end;

implementation

function TruncHoursBetween(former, later: TDateTime): Integer;
begin
  Result := Trunc(later * HoursPerDay) -
    Trunc(former * HoursPerDay);
end;

{ TDzMultiFileLogWritter }

constructor TDzMultiFileLogWritter.Create(const dir: string);
begin
  inherited Create;
  fDateTimeFormat := ShortTimeFormat;
  fVerbosity := TRACE_SEVERITIES_ALL;
  fOptions := [toSeverityTag, toTimeTick];
  fLogFileDir := dir;
  fLogSeparate := dtpDay;
  if fLogFileDir[Length(fLogFileDir)] <> '\' then
    fLogFileDir := fLogFileDir + '\';
end;

destructor TDzMultiFileLogWritter.Destroy;
begin
  inherited;
end;

procedure TDzMultiFileLogWritter.Flush;
begin
  fTrace.Flush;  
end;

procedure TDzMultiFileLogWritter.FormatWrite(Severity: TDzTraceSeverity;
  const fmt: WideString; const args: array of const);
begin
  Self.Write(Severity, WideFormat(fmt, args));
end;

procedure TDzMultiFileLogWritter.FormatWrite(Severity: TDzTraceSeverity;
  const fmt: AnsiString; const args: array of const);
begin
  Self.Write(Severity, Format(fmt, args));
end;

function TDzMultiFileLogWritter.GetAttribute(const Name: TNameString): Variant;
begin
  if SameText(Name, 'Encoding') then Result := Encoding
  else if SameText(Name, 'LogSeparate') then Result := LogSeparate
  else Result := inherited GetAttribute(Name);
end;

function TDzMultiFileLogWritter.GetDateTimeFormat: string;
begin
  Result := DateTimeFormat;
end;

function TDzMultiFileLogWritter.GetOptions: TTraceOptions;
begin
  Result := Options;
end;

function TDzMultiFileLogWritter.GetVerbosity: TDzTraceVerbosity;
begin
  Result := Severity;
end;

procedure TDzMultiFileLogWritter.CreateFileTracer(Tick: TDateTime);
var
  FileName: string;
  Changed: Boolean;
begin
  if fTrace = nil then Changed := True
  else begin
    case fLogSeparate of
      dtpYear: Changed := not SameYear(fLastLogTime, Tick);
      dtpMonth: Changed := not SameMonth(fLastLogTime, Tick);
      dtpDay: Changed := not SameDay(fLastLogTime, Tick);
      else Changed := not SameHour(fLastLogTime, Tick);
    end;
  end;

  if not Changed then Exit;

  fLastLogTime := Tick;
  case LogSeparate of
    dtpYear:FileName := fLogFileDir + FormatDateTime('yyyy', Tick) + '.log';
    dtpMonth:FileName := fLogFileDir + FormatDateTime('yyyymm', Tick) + '.log';
    dtpDay:FileName := fLogFileDir + FormatDateTime('yyyymmdd', Tick) + '.log';
    else FileName := fLogFileDir + FormatDateTime('yyyymmddhh', Tick) + '.log';
  end;
  fTrace := TDzFileTrace.Create(FileName);
  fTrace.Attributes['Encoding'] := Encoding;
  fTrace.DateTimeFormat := DateTimeFormat;
  fTrace.Options := Options;
  fTrace.Verbosity := Severity;
end;

procedure TDzMultiFileLogWritter.SetAttribute(const Name: TNameString;
  const Value: Variant);
begin
  if SameText(Name, 'Encoding') then Encoding := Value
  else if SameText(Name, 'LogSeparate') then LogSeparate := Value
  else inherited;
end;

procedure TDzMultiFileLogWritter.SetDateTimeFormat(const Value: string);
begin
  DateTimeFormat := Value;
  if fTrace <> nil then fTrace.DateTimeFormat := Value;
end;

procedure TDzMultiFileLogWritter.SetOptions(const Value: TTraceOptions);
begin
  Options := Value;
  if fTrace <> nil then fTrace.Options := Value;
end;

procedure TDzMultiFileLogWritter.SetVerbosity(const Value: TDzTraceVerbosity);
begin
  Severity := Value;
  if fTrace <> nil then fTrace.Verbosity := Value;
end;

procedure TDzMultiFileLogWritter.Write(Severity: TDzTraceSeverity;
  const Text: WideString);
begin
  CreateFileTracer(Now);
  fTrace.Write(Severity, Text);
end;

procedure TDzMultiFileLogWritter.Writeln(Severity: TDzTraceSeverity; const Text: AnsiString);
begin
  CreateFileTracer(Now);
  fTrace.Writeln(Severity, Text);
end;

procedure TDzMultiFileLogWritter.Writeln(Severity: TDzTraceSeverity; const Text: WideString);
begin
  CreateFileTracer(Now);
  fTrace.Writeln(Severity, Text);
end;

procedure TDzMultiFileLogWritter.Write(Severity: TDzTraceSeverity;
  const Text: AnsiString);
begin
  CreateFileTracer(Now);
  fTrace.Write(Severity, Text);
end;

{ TDzFixedSizeFileLogWritter }

constructor TDzFixedSizeFileLogWritter.Create(const dir: string);
begin
  inherited Create;
  fDateTimeFormat := ShortTimeFormat;
  fVerbosity := TRACE_SEVERITIES_ALL;
  fOptions := [toSeverityTag, toTimeTick];
  fLogFileDir := dir;
  fMaxFileSize := -1;
  if fLogFileDir[Length(fLogFileDir)] <> '\' then
    fLogFileDir := fLogFileDir + '\';
end;

destructor TDzFixedSizeFileLogWritter.Destroy;
begin
  fFileWritter.Free;
  inherited;
end;

procedure TDzFixedSizeFileLogWritter.Flush;
begin
  FlushFileBuffers(fFileHandle);
end;

procedure TDzFixedSizeFileLogWritter.FormatWrite(Severity: TDzTraceSeverity;
  const fmt: WideString; const args: array of const);
begin
  Self.Write(Severity, WideFormat(fmt, args));
end;

procedure TDzFixedSizeFileLogWritter.FormatWrite(Severity: TDzTraceSeverity;
  const fmt: AnsiString; const args: array of const);
begin
  Self.Write(Severity, Format(fmt, args));
end;

function TDzFixedSizeFileLogWritter.GetAttribute(const Name: TNameString): Variant;
begin
  if SameText(Name, 'Encoding') then Result := Encoding
  else if SameText(Name, 'MaxFileSize') then Result := fMaxFileSize
  else Result := inherited GetAttribute(Name);
end;

function TDzFixedSizeFileLogWritter.GetDateTimeFormat: string;
begin
  Result := DateTimeFormat;
end;

function TDzFixedSizeFileLogWritter.GetOptions: TTraceOptions;
begin
  Result := Options;
end;

function TDzFixedSizeFileLogWritter.GetVerbosity: TDzTraceVerbosity;
begin
  Result := Severity;
end;

procedure TDzFixedSizeFileLogWritter.CreateFileTracer(Tick: TDateTime);
var
  FileName: string;
  t: TSystemTime;
begin
  if INVALID_HANDLE_VALUE = fFileHandle then
  begin
    ForceDirectories(fLogFileDir);
    FileName := fLogFileDir + 'log.txt';

    fFileHandle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
      FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

    if INVALID_HANDLE_VALUE = fFileHandle then
    begin
      fFileHandle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
    end
    else
      SetFilePointer(fFileHandle, 0, nil, FILE_END);
  end;

  if INVALID_HANDLE_VALUE <> fFileHandle then
  begin
    if fMaxFileSize <= GetFileSize(fFileHandle, nil) then
    begin
      CloseHandle(fFileHandle);

      GetLocalTime(t);
      RenameFile(fLogFileDir + 'log.txt', Format('%s%u_%u_%u_%u_%u_%u.log', [
        fLogFileDir, t.wYear, t.wMonth, t.wDay,
        t.wHour, t.wMinute, t.wSecond]));

      fFileHandle := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
        FILE_SHARE_READ, nil, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
    end
  end;
end;

procedure TDzFixedSizeFileLogWritter.SetAttribute(const Name: TNameString;
  const Value: Variant);
begin
  if SameText(Name, 'Encoding') then Encoding := Value
  else if SameText(Name, 'MaxFileSize') then MaxFileSize := Value
  else inherited;
end;

procedure TDzFixedSizeFileLogWritter.SetDateTimeFormat(const Value: string);
begin
  DateTimeFormat := Value;
end;

procedure TDzFixedSizeFileLogWritter.SetOptions(const Value: TTraceOptions);
begin
  Options := Value;
end;

procedure TDzFixedSizeFileLogWritter.SetVerbosity(const Value: TDzTraceVerbosity);
begin
  Severity := Value;
end;

procedure TDzFixedSizeFileLogWritter.Write(Severity: TDzTraceSeverity;
  const Text: WideString);
begin
  CreateFileTracer(Now);
  //fTrace.Write(Severity, Text);
end;

procedure TDzFixedSizeFileLogWritter.Writeln(Severity: TDzTraceSeverity; const Text: AnsiString);
begin
  CreateFileTracer(Now);
  //fTrace.Writeln(Severity, Text);
end;

procedure TDzFixedSizeFileLogWritter.Writeln(Severity: TDzTraceSeverity; const Text: WideString);
begin
  CreateFileTracer(Now);
  //fTrace.Writeln(Severity, Text);
end;

procedure TDzFixedSizeFileLogWritter.Write(Severity: TDzTraceSeverity;
  const Text: AnsiString);
begin
  CreateFileTracer(Now);
  //fTrace.Write(Severity, Text);
end;

end.

